home *** CD-ROM | disk | FTP | other *** search
/ CICA 1993 April / CICA MS Windows - April 1993.iso / unzipped / programr / tp / wsound / wsound.pas
Pascal/Delphi Source File  |  1991-11-26  |  1KB  |  63 lines
  1. program SoundProg;
  2. uses WinTypes, WinProcs, WObjects;
  3. const
  4.   ButtonID= 100;
  5.  
  6. type
  7.   TMyApp = object(TApplication)
  8.    procedure InitMainWindow; virtual;
  9.   end;
  10.  
  11.   PMyWindow = ^TMyWindow;
  12.   TMyWindow = object(TWindow)
  13.       But: PButton;
  14.       DurationCount: integer;
  15.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  16.     procedure MakeNoise(var Msg: TMessage); virtual id_First + ButtonID;
  17.     procedure WMKillFocus(var Msg: TMessage); virtual wm_First + wm_KillFocus;
  18.   end;
  19.  
  20. procedure TMyApp.InitMainWindow;
  21. begin
  22.   MainWindow:= new(PMyWindow,init(nil,'Sound Window'));
  23. end;
  24.  
  25. constructor TMyWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  26. begin
  27.   DurationCount:= 0;
  28.   TWindow.Init(AParent, ATitle);
  29.   but:= New(PButton,init(@self,ButtonId,'&Make Noise',10,10,100,50,false));
  30. end;
  31.  
  32. procedure TMyWindow.MakeNoise(var Msg: TMessage);
  33. const
  34.   Duration = 100;
  35. var
  36.   err: integer;
  37.   Pitch: integer;
  38. begin
  39.   OpenSound;
  40.   for Pitch:= 1 to 84 do
  41.     begin                 
  42.       SetVoiceNote(1, Pitch, 10, 1);
  43.     end;
  44.   StartSound;
  45.   WaitSoundState(S_QueueEmpty);
  46.   StopSound;
  47.   CloseSound;
  48. end;
  49.  
  50.  
  51. procedure TMyWindow.WMKillFocus(var Msg: TMEssage);
  52. begin
  53.   messageBeep(0);
  54. end;
  55.  
  56.  
  57. var
  58.   x: TMyApp;
  59. begin
  60.   x.Init('Test');
  61.   x.Run;
  62.   x.Done;
  63. end.